Data Transitions: visualising and animating patient flow

Neil Pettinger / John MacKintosh
2018-05-07

2014 - Rows of Dots

plot of chunk unnamed-chunk-1

But can you tell me about what that original plot sought to demonstrate? Response 1 I can’t remember exactly where rows of dots came from but when I first experimented with them I just had two horizontal rows on a 24-hour timeline. Red arrivals were the top line. Blue departures were the line below.

2017 Red, Green and Grey Dots

plot of chunk unnamed-chunk-2

The original plot then became more sophisticated Can you talk through the evolution of this plot and the underlying theories and perspectives that drove this?

Excel Method : 1

plot of chunk unnamed-chunk-3

Excel Method : 2

plot of chunk unnamed-chunk-4

Excel Output

plot of chunk unnamed-chunk-5

How can we do this in R?

plot of chunk unnamed-chunk-6

What is R?

plot of chunk unnamed-chunk-7

How does it compare to Excel?

plot of chunk unnamed-chunk-8plot of chunk unnamed-chunk-8

  • open source - free to use
  • 1000 functions in base installation
  • several updates to base installation per year
  • 12000 + user contributed packages
  • machine learning, mapping, medical imaging

4 stage process

  • load the packages we need
  • import the data from Excel
  • transform the data
  • create the plot

Load the required packages

library(tidyverse) # a suite of packages with common conventions
library(lubridate) # better handling of dates
library(scales) # easier plot scales
library(readxl) # easy import from Excel
library(hrbrthemes) # custom plot theme
library(extrafont) # loads fonts required for hrbrthemes on Windows

Import the data

data <- read_xlsx("RedGreenGreyDots.xlsx", sheet = "Data (0)")

Check the data was imported correctly

str(data)  #could also have used glimpse(data)

Classes 'tbl_df', 'tbl' and 'data.frame':   684 obs. of  7 variables:
 $ MovementDateTime: POSIXct, format: "2014-09-03 00:01:00" "2014-09-03 00:03:00" ...
 $ FirstName       : chr  "MOIRA" "DORIS" "DORIS" "MARGARET" ...
 $ LastName        : chr  "MACLEOD" "WALLHEAD" "WALLHEAD" "MILNE" ...
 $ Ward_Dept       : chr  "A&E" "A&E" "Ward 02 (AMU)" "A&E" ...
 $ Staging_Post    : chr  "A&E" "A&E" "Assessment" "A&E" ...
 $ Movement_Type   : chr  "Departure" "Transfer Out" "Transfer In" "Departure" ...
 $ IN_OUT          : chr  "OUT" "OUT" "IN" "OUT" ...

View the data

knitr::kable(head(data))
MovementDateTime FirstName LastName Ward_Dept Staging_Post Movement_Type IN_OUT
2014-09-03 00:01:00 MOIRA MACLEOD A&E A&E Departure OUT
2014-09-03 00:03:00 DORIS WALLHEAD A&E A&E Transfer Out OUT
2014-09-03 00:03:00 DORIS WALLHEAD Ward 02 (AMU) Assessment Transfer In IN
2014-09-03 00:04:00 MARGARET MILNE A&E A&E Departure OUT
2014-09-03 00:05:00 GEORGE EVANS A&E A&E Departure OUT
2014-09-03 00:05:00 MARJORIE ROSS A&E A&E Departure OUT

Transform the data using dplyr package

plot_data <- data %>% 
  mutate(Movement15 = lubridate::floor_date(MovementDateTime,"15 minutes")) %>% 
  group_by(IN_OUT, Movement_Type,Staging_Post,Movement15) %>% 
  mutate(counter = case_when(
    IN_OUT == 'IN' ~ 1,
    IN_OUT == 'OUT' ~ -1)) %>% 
  mutate(Movement_15_SEQNO = cumsum(counter)) %>% 
  ungroup()

knitr::kable(plot_data[1:6,5:10])
Staging_Post Movement_Type IN_OUT Movement15 counter Movement_15_SEQNO
A&E Departure OUT 2014-09-03 -1 -1
A&E Transfer Out OUT 2014-09-03 -1 -1
Assessment Transfer In IN 2014-09-03 1 1
A&E Departure OUT 2014-09-03 -1 -2
A&E Departure OUT 2014-09-03 -1 -3
A&E Departure OUT 2014-09-03 -1 -4

Simplify the Movement Type field

plot_data$Movement_Type <- gsub("Transfer.*","Transfer",x = plot_data$Movement_Type)

knitr::kable(plot_data[1:6,5:10])
Staging_Post Movement_Type IN_OUT Movement15 counter Movement_15_SEQNO
A&E Departure OUT 2014-09-03 -1 -1
A&E Transfer OUT 2014-09-03 -1 -1
Assessment Transfer IN 2014-09-03 1 1
A&E Departure OUT 2014-09-03 -1 -2
A&E Departure OUT 2014-09-03 -1 -3
A&E Departure OUT 2014-09-03 -1 -4

Step 4 - Create the plot

lims <- as.POSIXct(strptime(c("2014-09-03 00:00","2014-09-04 01:00")
                            , format = "%Y-%m-%d %H:%M"))

preparation step - setting axis limits in the correct time date format

Initial basic plot using ggplot2 package

ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour = Movement_Type)) + 
  geom_point()

output 1

plot of chunk unnamed-chunk-18

Manually specify colours

ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour = Movement_Type)) +
  geom_jitter(width = 0.10) +
  scale_colour_manual(values = c("#D7100D","#40B578","grey60"))

output 2

plot of chunk unnamed-chunk-20

Create small multiple

p <- ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour = Movement_Type)) +
  geom_jitter(width = 0.10) +
  scale_colour_manual(values = c("#D7100D","#40B578","grey60")) +
  facet_grid(Staging_Post~., switch = "y") +
  scale_x_datetime(date_labels = "%H:%M",date_breaks = "3 hours",
                   limits = lims,
                   timezone = "UTC",
                   expand = c(0,0)) 
p

output 3

plot of chunk unnamed-chunk-22

themes, formatting and labels

p <- p + theme_ipsum(base_family = "Arial Narrow") +
  theme(axis.text.y = element_blank(),
        axis.ticks.y = element_blank()) +
  theme(axis.text.x = element_text(size = 7)) +
  theme(axis.ticks.x = element_blank()) +
  theme(legend.position = "bottom") +
  theme(panel.grid.minor = element_blank(),
        panel.grid.major = element_blank()) +
  theme(strip.text.y = element_text(angle = 180)) +
  guides(color = guide_legend("Movement Type")) +
  ggtitle(label = "Anytown General Hospital | Wednesday 3rd September 2014 00:00 to 23:59\n",
          subtitle = "A&E AND INPATIENT ARRIVALS, DEPARTURES AND TRANSFERS") +
  labs(x = NULL, y = NULL) 
p

final plot

plot of chunk unnamed-chunk-24

library(ggplot2)
library(extrafont)
library(hrbrthemes)
theme_set(theme_ipsum())


library(gganimate)

animation::ani.options(interval = .5,ani.width = 900, ani.height = 600, ani.res = 300)

lims <- as.POSIXct(strptime(c("2014-09-03 00:00","2014-09-04 01:00")
                            , format = "%Y-%m-%d %H:%M"))  


p <- ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour=Movement_Type, frame = Movement15,cumulative = TRUE))+
  geom_jitter(width=0.10)+
  scale_colour_manual(values=c("#D7100D","#40B578","grey60"))+
  facet_grid(Staging_Post~.,switch = "y")+
  scale_x_datetime(date_labels="%H:%M",date_breaks = "3 hours",
                   limits = lims,
                   timezone = "GMT",
                   expand = c(0,0))+
  ggtitle(label = "Anytown General Hospital | Wednesday 3rd September 2014 00:00 to 23:59\n",
          subtitle="A&E AND INPATIENT ARRIVALS, DEPARTURES AND TRANSFERS")+
  labs(x= NULL, y= NULL,
       caption="@HighlandDataSci | johnmackintosh.com  Source: Neil Pettinger | @kurtstat | kurtosis.co.uk")+
  theme_ipsum(base_family = "Arial Narrow")+
  theme(axis.text.y=element_blank(),
        axis.ticks.y=element_blank())+
  theme(axis.text.x=element_text(size=7)) +
  theme(axis.ticks.x=element_blank())+
  theme(legend.position="bottom")+
  theme(panel.grid.minor=element_blank(),
        panel.grid.major=element_blank())+
  theme(strip.text.y = element_text(angle = 180))+
  guides(color=guide_legend("Movement Type"))+
  ggExtra::removeGrid() 

gganimate(p,filename = "row_of_dots_output.gif")